module Evaluation where

import Control.Monad
import Control.Monad.Error
import qualified Data.Map as Map
import qualified Stepwise as SW
import qualified ResultState as RS
import Identifier
import Pointer
import qualified Environment as Env
import qualified Heap
import Result
import Data.Maybe
import qualified SExpressions as SE
import qualified Array
import Language
import Accessor


local :: Environment -> ThreadProcedure a -> ThreadProcedure a
--------------------------------------------------------------
local env tp = do oldEnv <- get lexicalEnvironment
                  set lexicalEnvironment env
                  result <- tp
                  set lexicalEnvironment oldEnv
                  return result


protectEnvironment :: ThreadProcedure a -> ThreadProcedure a
------------------------------------------------------------
protectEnvironment tp = do env <- get lexicalEnvironment
                           local env tp


expandMacro :: [Value] -> Environment -> Identifier -> ThreadProcedure Value -> ThreadProcedure Value
-----------------------------------------------------------------------------------------------------
expandMacro args env id tproc = local (Env.bind id (List args Nothing) env) tproc


invoke :: Value -> [Value] -> ThreadProcedure Value
---------------------------------------------------
invoke (NativeFunction _ f _)             xs = f xs
invoke (Closure Strict env param tproc _) xs = do args <- mapM evaluate xs
                                                  local (Env.bind param (List args Nothing) env) tproc
invoke (Closure Macro env param tproc _)  xs = do result <- expandMacro xs env param tproc
                                                  evaluate result
invoke  v                                 xs = throwError $ notCallableException v


evaluate :: Value -> ThreadProcedure Value
------------------------------------------
evaluate v@(Integer n _)          = return v
evaluate v@(String s _)           = return v
evaluate v@(Boolean b _)          = return v
evaluate v@(Keyword s _)          = return v
evaluate v@(Closure _ _ _ _ _)    = return v
evaluate v@(NativeFunction _ _ _) = return v
evaluate v@(Unit _)               = return v
evaluate (Symbol s _)             = do result <- with lexicalEnvironment $ Env.lookup (Identifier s)
                                       case result of
                                         Just v  -> return v
                                         Nothing -> throwError $ unboundSymbolException (Symbol s Nothing)
evaluate (List [] _)              = return (Unit Nothing)
evaluate (List (x:xs) _)          = do v <- evaluate x
                                       invoke v xs


